home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / oobpls10.zip / GIFVIDEO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-06  |  54KB  |  2,234 lines
  1. {$A+,F+,R-,S-,T-,V-,X+}
  2.  
  3. {***********************************************}
  4. {*            GIFVIDEO.PAS  1.0d               *}
  5. {*       Copyright (c) Steve Sneed 1991        *}
  6. {*            All Rights Reserved              *}
  7. {*                                             *}
  8. {*  Provided to TurboPower Software for their  *}
  9. {*   use or distribution with their products   *}
  10. {***********************************************}
  11.  
  12. {$IFNDEF Ver60}
  13. {$IFNDEF Ver70}
  14.   !! FATAL: This unit requires TP6 or later !!
  15. {$ENDIF}
  16. {$ENDIF}
  17.  
  18. unit GIFVideo;  {basic video routines for example GIF decoder}
  19.  
  20. {The following define controls whether SVGA capabilities are supported.  If
  21.  you don't have an SVGA card, undefining this conditional will save you some
  22.  code and data space.}
  23.  
  24. {$DEFINE UseSVGA}
  25.  
  26. interface
  27.  
  28. uses
  29.   DOS,
  30.   Dpmi,
  31.   OpString,
  32.   OpCrt,
  33.   DeGIF;
  34.  
  35. const
  36.   UnitVers = '1.0d';
  37.   UnitDate = '05-Jun-91';
  38.  
  39. const
  40.   DoDbl : Boolean = True;
  41.   Use50Line : Boolean = False;
  42.  
  43. const
  44.   VGASele        : Word = $A000;
  45.   VidBIOSSele    : Word = $C000;
  46.  
  47.   OldMode        : Word = 3;        {our starting text mode}
  48.   OldFont8x8     : Boolean = False; {TRUE if in 8x8 font mode}
  49.   GraphOn        : Boolean = False; {TRUE when we are in a graphics vid mode}
  50.   SVGAType       : Integer = 0;     {our type number for the SVGA chipset}
  51.   VidChecked     : Boolean = False; {TRUE after SVGAType checked at least once}
  52.   VESAAvail      : Boolean = False; {TRUE if a VESA driver is found}
  53.   ViaBIOS        : Boolean = False; {TRUE to use the BIOS for bankswitching}
  54.   AllowEGAMode12 : Boolean = True;  {set FALSE if your EGA can't do Mode $12}
  55.  
  56.   m360x480x256   = $F0;  {special VGA "Mode X" identifier}
  57.  
  58. {$IFDEF UseSVGA}
  59. const
  60.     {consts for popular SVGA chipsets}
  61.   vtEGAVGA      = 0;
  62.   vtCirrus      = 1;
  63.   vtEverex      = 2;
  64.   vtAcuMOS      = 3;
  65.   vtParadise    = 4;
  66.   vtTrident8800 = 5;
  67.   vtTrident8900 = 6;
  68.   vtTseng3000   = 7;
  69.   vtTseng4000   = 8;
  70.   vtAtiVGA      = 9;
  71.   vtAheadA      = 10;
  72.   vtAheadB      = 11;
  73.   vtOakTech     = 12;
  74.   vtVideo7      = 13;
  75.   vtChipsTech   = 14;
  76.   vtGenoa       = 15;
  77.   vtNCR         = 16;
  78.   vtCompaq      = 17;
  79.   vtS3VGA       = 18;
  80.   vtVESA        = 19;
  81.  
  82. (* NOTE: Those types marked with {*} _require_ a VESA driver to be in use! *)
  83.   SVGANames : Array[vtEGAVGA..vtVESA] of String[12] =
  84.                 ('Standard VGA',
  85.                  'Cirrus',             {*}
  86.                  'Everex',
  87.                  'AcuMOS',
  88.                  'Paradise',
  89.                  'Trident 8800',
  90.                  'Trident 8900',
  91.                  'Tseng 3000',
  92.                  'Tseng 4000',
  93.                  'VGA Wonder',
  94.                  'Ahead "A"',
  95.                  'Ahead "B"',
  96.                  'Oak Tech.',
  97.                  'Video 7',
  98.                  'C & T',
  99.                  'Genoa',
  100.                  'NCR',
  101.                  'Compaq',             {*}
  102.                  'S3 SVGA',            {*}
  103.                  'VESA driver');
  104.  
  105.     {internal consts for "typical" SVGA modes we support.  These numbers were}
  106.     {chosen because they do not conflict with any known BIOS mode numbers.}
  107.   m640x400x256     = $F1;
  108.   m640x480x256     = $F2;
  109.   m800x600x16      = $F3;
  110.   m800x600x256     = $F4;
  111.   m1024x768x16     = $F5;
  112.   m1024x768x256    = $F6;
  113.   m1024x768x32768  = $F7;
  114.   m1280x1024x16    = $F8;
  115.   m1280x1024x256   = $F9;
  116.   m1280x1024x32768 = $FA;
  117. {$ENDIF}
  118.  
  119. type
  120.   PlotLineProc = procedure(Y : Word);   {proc ptr type for PlotLine to use}
  121.  
  122. {$IFDEF UseSVGA}
  123. type
  124.     {Our mode table record types}
  125.   ModeRecord =
  126.     record
  127.       Index   : Byte;
  128.       ModeAX  : Word;
  129.       ModeBL  : Byte;
  130.       MaxC    : Word;
  131.     end;
  132.   ModeTable = Array[1..6] of ModeRecord;
  133.  
  134. type
  135.   s80 = string[80];
  136.   s8  = string[8];
  137.  
  138.     {types used in the VESA main records}
  139.   ByteString = Array[0..3] of Byte;
  140.   CharString = array[0..3] of Char;
  141.   CharStringPtr = ^CharString;
  142.  
  143.     {pointer to a null-terminated list of words defining *all* modes the}
  144.     {card supports, including text and non-VESA graphics modes.  The}
  145.     {VESA mode numbers will typically be the last ones in the list.}
  146.   ModeListType = array[0..0] of Word;
  147.   ModeListPtr = ^ModeListType;
  148.  
  149. var
  150.   VGAMem  : Word;
  151.   BkSize  : Word;
  152.   CurBk   : Word;
  153.  
  154. type
  155.     {Record for basic VESA support info (VESA service $00)}
  156.   VgaInfoBlockType =
  157.     record
  158.       VESASignature   : CharString;
  159.       VESAVersion     : word;
  160.       OEMStringPtr    : CharStringPtr;
  161.       Capabilities    : ByteString;
  162.       VideoModePtr    : ModeListPtr;
  163.       reserved        : array[$00..$ED] of Byte;     {Pad to 256}
  164.     end;
  165.  
  166.     {pointer to a procedure that performs special memory paging.  This}
  167.     {proc may exist within the hardware BIOS or in the VESA driver, or}
  168.     {it may be null and be used for other things.}
  169.   PageFuncPtrType = Pointer;
  170.  
  171.     {Record containing information on a specific video mode.  IMPORTANT:}
  172.     {the card *must be in the requested mode* when VESA service $03 is}
  173.     {called for this structure to be guaranteed to contain meaningful}
  174.     {information!}
  175.   ModeInfoBlockType =
  176.     record
  177.         {mandatory information}
  178.       ModeAttributes  : word;
  179.       WinAAttributes  : byte;
  180.       WinBAttributes  : byte;
  181.       WinGranularity  : word;
  182.       WinSize         : word;
  183.       WinASegment     : word;
  184.       WinBSegment     : word;
  185.       WinFuncPtr      : PageFuncPtrType;
  186.       BytesPerScanLine : word;
  187.         {optional information}
  188.       XResolution     : word;
  189.       YResolution     : word;
  190.       XCharSize       : byte;
  191.       YCharSize       : byte;
  192.       NumberOfPlanes  : byte;
  193.       BitsPerPixel    : byte;
  194.       NumberOfBanks   : byte;
  195.       MemoryModel     : byte;
  196.       BankSize        : byte;
  197.       reserved        : array[$00..$E2] of Byte;     {Pad to 256}
  198.     end;
  199.  
  200.  
  201.   { NOTE: The following tables assume at least 512k video memory is on the }
  202.   { supported card, with 1Mb on those that can handle it (Tseng 4000 and   }
  203.   { Trident 8900, Ahead B/5000, etc.)                                      }
  204. const
  205.   Tseng3000Table : ModeTable =
  206.     ((Index : m640x400x256;   ModeAX : $002d;  ModeBL : $00; MaxC : 256),
  207.      (Index : m640x480x256;   ModeAX : $002e;  ModeBL : $00; MaxC : 256),
  208.      (Index : m800x600x16;    ModeAX : $0029;  ModeBL : $00; MaxC : 16),
  209.      (Index : m800x600x256;   ModeAX : $0030;  ModeBL : $00; MaxC : 256),
  210.      (Index : m1024x768x16;   ModeAX : $0037;  ModeBL : $00; MaxC : 16),
  211.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  212.  
  213.   Tseng4000Table : ModeTable =
  214.     ((Index : m640x400x256;   ModeAX : $002f;  ModeBL : $00; MaxC : 256),
  215.      (Index : m640x480x256;   ModeAX : $002e;  ModeBL : $00; MaxC : 256),
  216.      (Index : m800x600x16;    ModeAX : $0029;  ModeBL : $00; MaxC : 16),
  217.      (Index : m800x600x256;   ModeAX : $0030;  ModeBL : $00; MaxC : 256),
  218.      (Index : m1024x768x16;   ModeAX : $0037;  ModeBL : $00; MaxC : 16),
  219.      (Index : m1024x768x256;  ModeAX : $0038;  ModeBL : $00; MaxC : 256));
  220.  
  221.   TridentTable : ModeTable =
  222.     ((Index : m640x400x256;   ModeAX : $005c;  ModeBL : $00; MaxC : 256),
  223.      (Index : m640x480x256;   ModeAX : $005d;  ModeBL : $00; MaxC : 256),
  224.      (Index : m800x600x16;    ModeAX : $005b;  ModeBL : $00; MaxC : 16),
  225.      (Index : m800x600x256;   ModeAX : $005e;  ModeBL : $00; MaxC : 256),
  226.      (Index : m1024x768x16;   ModeAX : $005f;  ModeBL : $00; MaxC : 16),
  227.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  228.  
  229.   Trident8900Table : ModeTable =
  230.     ((Index : m640x400x256;   ModeAX : $005c;  ModeBL : $00; MaxC : 256),
  231.      (Index : m640x480x256;   ModeAX : $005d;  ModeBL : $00; MaxC : 256),
  232.      (Index : m800x600x16;    ModeAX : $005b;  ModeBL : $00; MaxC : 16),
  233.      (Index : m800x600x256;   ModeAX : $005e;  ModeBL : $00; MaxC : 256),
  234.      (Index : m1024x768x16;   ModeAX : $005f;  ModeBL : $00; MaxC : 16),
  235.      (Index : m1024x768x256;  ModeAX : $0062;  ModeBL : $00; MaxC : 256));
  236.  
  237.   AheadTable : ModeTable =
  238.     ((Index : m640x400x256;   ModeAX : $0060;  ModeBL : $00; MaxC : 256),
  239.      (Index : m640x480x256;   ModeAX : $0061;  ModeBL : $00; MaxC : 256),
  240.      (Index : m800x600x16;    ModeAX : $006A;  ModeBL : $00; MaxC : 16),
  241.      (Index : m800x600x256;   ModeAX : $0062;  ModeBL : $00; MaxC : 256),
  242.      (Index : m1024x768x16;   ModeAX : $0074;  ModeBL : $00; MaxC : 16),
  243.      (Index : m1024x768x256;  ModeAX : $0063;  ModeBL : $00; MaxC : 256));
  244.  
  245.   AcuMOSTable : ModeTable =
  246.     ((Index : m640x400x256;   ModeAX : $0059;  ModeBL : $00; MaxC : 256),
  247.      (Index : m640x480x256;   ModeAX : $005F;  ModeBL : $00; MaxC : 256),
  248.      (Index : m800x600x16;    ModeAX : $0058;  ModeBL : $00; MaxC : 16),
  249.      (Index : m800x600x256;   ModeAX : $005C;  ModeBL : $00; MaxC : 256),
  250.      (Index : m1024x768x16;   ModeAX : $005D;  ModeBL : $00; MaxC : 16),
  251.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  252.  
  253.   GenoaTable : ModeTable =
  254.     ((Index : m640x400x256;   ModeAX : $007E;  ModeBL : $00; MaxC : 256),
  255.      (Index : m640x480x256;   ModeAX : $005C;  ModeBL : $00; MaxC : 256),
  256.      (Index : m800x600x16;    ModeAX : $0079;  ModeBL : $00; MaxC : 16),
  257.      (Index : m800x600x256;   ModeAX : $005E;  ModeBL : $00; MaxC : 256),
  258.      (Index : m1024x768x16;   ModeAX : $005F;  ModeBL : $00; MaxC : 16),
  259.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  260.  
  261.   NCRTable : ModeTable =
  262.     ((Index : m640x400x256;   ModeAX : $005E;  ModeBL : $00; MaxC : 256),
  263.      (Index : m640x480x256;   ModeAX : $005F;  ModeBL : $00; MaxC : 256),
  264.      (Index : m800x600x16;    ModeAX : $0058;  ModeBL : $00; MaxC : 16),
  265.      (Index : m800x600x256;   ModeAX : $005C;  ModeBL : $00; MaxC : 256),
  266.      (Index : m1024x768x16;   ModeAX : $005D;  ModeBL : $00; MaxC : 16),
  267.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  268.  
  269.   OakTable : ModeTable =
  270.     ((Index : m640x400x256;   ModeAX : $0051;  ModeBL : $00; MaxC : 256),
  271.      (Index : m640x480x256;   ModeAX : $0053;  ModeBL : $00; MaxC : 256),
  272.      (Index : m800x600x16;    ModeAX : $0052;  ModeBL : $00; MaxC : 16),
  273.      (Index : m800x600x256;   ModeAX : $0054;  ModeBL : $00; MaxC : 256),
  274.      (Index : m1024x768x16;   ModeAX : $0056;  ModeBL : $00; MaxC : 16),
  275.      (Index : m1024x768x256;  ModeAX : $0058;  ModeBL : $00; MaxC : 256));
  276.  
  277.   ATITable : ModeTable =
  278.     ((Index : m640x400x256;   ModeAX : $0061;  ModeBL : $00; MaxC : 256),
  279.      (Index : m640x480x256;   ModeAX : $0062;  ModeBL : $00; MaxC : 256),
  280.      (Index : m800x600x16;    ModeAX : $0054;  ModeBL : $00; MaxC : 16),
  281.      (Index : m800x600x256;   ModeAX : $0063;  ModeBL : $00; MaxC : 256),
  282.      (Index : m1024x768x16;   ModeAX : $0065;  ModeBL : $00; MaxC : 16),
  283.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  284.  
  285.   ChipsTechTable : ModeTable =
  286.     ((Index : m640x400x256;   ModeAX : $0078;  ModeBL : $00; MaxC : 256),
  287.      (Index : m640x480x256;   ModeAX : $0079;  ModeBL : $00; MaxC : 256),
  288.      (Index : m800x600x16;    ModeAX : $0070;  ModeBL : $00; MaxC : 16),
  289.      (Index : m800x600x256;   ModeAX : $007b;  ModeBL : $00; MaxC : 256),
  290.      (Index : m1024x768x16;   ModeAX : $0072;  ModeBL : $00; MaxC : 16),
  291.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  292.  
  293.   ParadiseTable : ModeTable =
  294.     ((Index : m640x400x256;   ModeAX : $005e;  ModeBL : $00; MaxC : 256),
  295.      (Index : m640x480x256;   ModeAX : $005f;  ModeBL : $00; MaxC : 256),
  296.      (Index : m800x600x16;    ModeAX : $0058;  ModeBL : $00; MaxC : 16),
  297.      (Index : m800x600x256;   ModeAX : $005C;  ModeBL : $00; MaxC : 256),
  298.      (Index : m1024x768x16;   ModeAX : $005d;  ModeBL : $00; MaxC : 16),
  299.      (Index : 0;              ModeAX : $0000;  ModeBL : $00; MaxC : 0));
  300.  
  301.   EverexTable : ModeTable =
  302.     ((Index : m640x400x256;   ModeAX : $0070;  ModeBL : $14; MaxC : 256),
  303.      (Index : m640x480x256;   ModeAX : $0070;  ModeBL : $30; MaxC : 256),
  304.      (Index : m800x600x16;    ModeAX : $0070;  ModeBL : $02; MaxC : 16),
  305.      (Index : m800x600x256;   ModeAX : $0070;  ModeBL : $31; MaxC : 256),
  306.      (Index : m1024x768x16;   ModeAX : $0070;  ModeBL : $20; MaxC : 16),
  307.      (Index : m1024x768x256;  ModeAX : $0070;  ModeBL : $32; MaxC : 256));
  308.  
  309.   Video7Table : ModeTable =
  310.     ((Index : m640x400x256;   ModeAX : $6f05;  ModeBL : $66; MaxC : 256),
  311.      (Index : m640x480x256;   ModeAX : $6f05;  ModeBL : $67; MaxC : 256),
  312.      (Index : m800x600x16;    ModeAX : $6f05;  ModeBL : $62; MaxC : 16),
  313.      (Index : m800x600x256;   ModeAX : $6f05;  ModeBL : $69; MaxC : 256),
  314.      (Index : m1024x768x16;   ModeAX : $6f05;  ModeBL : $65; MaxC : 16),
  315.      (Index : m1024x768x256;  ModeAX : $6f05;  ModeBL : $6A; MaxC : 256));
  316.  
  317.   VESATable : ModeTable =
  318.     ((Index : m640x400x256;     ModeAX : $0100;  ModeBL : $00; MaxC : 256),
  319.      (Index : m640x480x256;     ModeAX : $0101;  ModeBL : $00; MaxC : 256),
  320.      (Index : m800x600x16;      ModeAX : $0102;  ModeBL : $00; MaxC : 16),
  321.      (Index : m800x600x256;     ModeAX : $0103;  ModeBL : $00; MaxC : 256),
  322.      (Index : m1024x768x16;     ModeAX : $0104;  ModeBL : $00; MaxC : 16),
  323.      (Index : m1024x768x256;    ModeAX : $0105;  ModeBL : $00; MaxC : 256));
  324.  
  325. var
  326.   VESAModeList : Array[0..7] of Word;      {table for available VESA modes}
  327.   ModeList     : ModeTable;                {our selected mode table}
  328.   VesaVgaInfo  : VgaInfoBlockType;
  329.   VesaModeInfo : ModeInfoBlockType;
  330. {$ENDIF}
  331.  
  332. var
  333.   SelMode   : Byte;                     {our selected video mode}
  334.   {LeftEdge  : Integer;}                  {leftmost pixel of image (0-based)}
  335.   {RightEdge : Integer;}                  {rightmost pixel of image}
  336.   TopEdge   : Integer;                  {topmost raster line of image (0-based)}
  337.   BotEdge   : Integer;                  {lowest raster line in image}
  338.   Raster    : Integer;                  {number of scanlines in selected mode}
  339.   Pixels    : Integer;                  {width in pixels of selected mode}
  340.   PlotLine  : PlotLineProc;             {our pointer to PlotLine for mode}
  341.   YCord     : Word;                     {the current raster line to plot}
  342.  
  343. type
  344.     {EGA/VGA palette needs}
  345.   VGAPalRec =
  346.     record
  347.       Red,Grn,Blu : Byte;
  348.     end;
  349.  
  350.   VGAPalType = Array[0..255] of VGAPalRec;  {array of RGB triplets for DAC}
  351.   EGAPalType = Array[0..16] of Byte;        {include border register}
  352.  
  353. const
  354.   DefEGAPal : EGAPalType =  {the default EGA palette}
  355.     ($00,$01,$02,$03,$04,$05,$14,$07,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F,$00);
  356.  
  357. var
  358.   VGAPalette  : VGAPalType;
  359.   EGAPalette  : EGAPalType;
  360.   UniqueCols  : Integer;
  361.  
  362. procedure DoMapping;
  363.   {-convert a GIF 24-bit color map to a useable form}
  364.  
  365. procedure SetDefMap;
  366.   {-set a default map when none is in the image}
  367.  
  368. {$IFDEF UseSVGA}
  369. procedure DetectSVGAType(CheckHW : Boolean);
  370.   {-detect whether VESA driver is installed}
  371. {$ENDIF}
  372.  
  373. procedure AdjustPalette(Mode : Byte);
  374.   {-set hardware palette to match image and mode}
  375.  
  376. procedure SetGraphicsMode(Mode : Byte);
  377.   {-select graphics mode}
  378.  
  379. procedure SetTextMode;
  380.   {-restore text mode}
  381.  
  382. function SelectMode(X,Y : Word) : Byte;
  383.   {-select mode to use based on image dimensions}
  384.  
  385. implementation
  386.  
  387. var
  388.   EGABytesPerLine : Integer;    {used by EGA plotting routine}
  389.   BankSize : Word;
  390.  
  391. const
  392.   First   : Boolean = False;
  393.   RetVal  : Integer = 0;
  394.   BankAdr : Word = 0;
  395.  
  396.  
  397. {------------------------}
  398. { Color mapping services }
  399. {------------------------}
  400.  
  401.   FUNCTION PaletteValue(I : Integer) : Byte;
  402.     {-return the 6-bit (EGA) color for the I'th VGA colormap entry}
  403.   VAR B, GI : Byte;
  404.   begin
  405.     with TempMap do begin
  406.       GI := $00;
  407.       B := Map[I, RedVal];
  408.       case B of
  409.         $C0..$FF:
  410.           GI := GI or $24;   {100100b}  {high-intensity}
  411.         $80..$BF:
  412.           GI := GI or $04;   {000100b}  {low-intensity}
  413.         $40..$7F:
  414.           GI := GI or $20;   {100000b}  {medium-intensity}
  415.       end;
  416.  
  417.       B := Map[I, GreenVal];
  418.       case B of
  419.         $C0..$FF:
  420.           GI := GI or $12;   {010010b}
  421.         $80..$BF:
  422.           GI := GI or $02;   {000010b}
  423.         $40..$7F:
  424.           GI := GI or $10;   {010000b}
  425.       end;
  426.  
  427.       B := Map[I, BlueVal];
  428.       case B of
  429.         $C0..$FF:
  430.           GI := GI or $09;   {001001b}
  431.         $80..$BF:
  432.           GI := GI or $01;   {000001b}
  433.         $40..$7F:
  434.           GI := GI or $08;   {001000b}
  435.       end;
  436.  
  437.       PaletteValue := GI;
  438.     end
  439.   end;
  440.  
  441.   procedure DoMapping;
  442.     {-perform color mapping/conversion}
  443.   var
  444.     Temp,I,J,K,GI : byte;
  445.     EGATemp,Votes : array[0..63] of byte;
  446.  
  447.     procedure SetColorA(I : Integer);
  448.     var
  449.       N : Integer;
  450.       J : Integer;
  451.     begin
  452.       {find the nearest EGA color for the color number}
  453.       GI := PaletteValue(I);
  454.       for J := 1 to 4 do begin
  455.         {walk thru the palette, looking for a match}
  456.         for N := 0 to 15 do
  457.           if GI = EGAPalette[n] then begin
  458.             {match found, set Color[] and leave}
  459.             Color[i] := N;
  460.             exit;
  461.           end;
  462.         {match not found, move to next related color and try again}
  463.         GI := (GI + 16) mod 64
  464.       end;
  465.       {should never get here, but just in case we set the color to the
  466.        previous slot's value}
  467.       Color[i] := Color[i-1];
  468.     end;
  469.  
  470.     procedure ExchangeBytes(var B1, B2 : Byte);
  471.     var
  472.       B3 : Byte;
  473.     begin
  474.       B3 := B1;
  475.       B1 := B2;
  476.       B2 := B3;
  477.     end;
  478.  
  479.   begin
  480.     EGAPalette := DefEGAPal;
  481.     TempMap := Maps[CurMap];
  482.     with TempMap do begin
  483.       {initialize the VGA palette}
  484.       for I := 0 to HighColorNum do begin
  485.         VGAPalette[I].Red := Map[I,RedVal] SHR 2;
  486.         VGAPalette[I].Grn := Map[I,GreenVal] SHR 2;
  487.         VGAPalette[I].Blu := Map[I,BlueVal] SHR 2;
  488.         Color[I] := I;
  489.       end;
  490.  
  491.       if MaxColors < 256 then begin
  492.         if HighColorNum > 15 then begin
  493.           {more colors than will fit in the palette; we have to perform
  494.            color reduction.}
  495.  
  496.           {init important vars}
  497.           for I := 0 to 63 do begin
  498.             Votes[i] := 0;
  499.             EGATemp[i] := i;
  500.           end;
  501.  
  502.           {First find which of the 64 EGA colors is most popular...}
  503.           for I := 0 to HighColorNum do begin
  504.             GI := PaletteValue(I);
  505.             inc(Votes[GI]);
  506.           end;
  507.  
  508.           {sort the votes; put the top 16 in the palette}
  509.           for I := 0 to 15 do begin
  510.             for J := I to 63 do begin
  511.               if Votes[j] > Votes[i] then begin
  512.                 ExchangeBytes(Votes[j], Votes[i]);
  513.                 ExchangeBytes(EGATemp[j], EGATemp[i]);
  514.               end;
  515.             end;
  516.           end;
  517.  
  518.           {load the palette}
  519.           Move(EGATemp, EGAPalette, 16);
  520.  
  521.           {finally, set up Color[] to work with the palette}
  522.           for I := 0 to HighColorNum do
  523.             SetColorA(I);
  524.         end
  525.         else begin
  526.           {16 colors or less, just set things up equally}
  527.           for I := 0 to HighColorNum do begin
  528.             EGAPalette[I] := PaletteValue(I);
  529.             Color[I] := I;
  530.           end;
  531.         end;
  532.       end;
  533.     end;
  534.   end;
  535.  
  536.   procedure SetDefMap;
  537.     {-assign default map.  There is no defined default map in the spec, but}
  538.     { this method matches that used by many decoders.}
  539.   var i : byte;
  540.   begin
  541.     with Maps[CurMap] do
  542.       for i := 0 to HighColorNum do
  543.         Color[i] := i MOD succ(HighColorNum);
  544.   end;
  545.  
  546. {----------------------}
  547. { SVGA detect routines }
  548. {----------------------}
  549.  
  550. {$IFDEF UseSVGA}
  551.  
  552.   procedure AdjustVESATable;
  553.     {-adjusts the VESA modestable to reflect actual VESA modes supported}
  554.   var
  555.     W : Word;
  556.     B : Array[0..5] of Boolean;
  557.   begin
  558.     FillChar(B,SizeOf(B),0);
  559.     with VesaVgaInfo do begin
  560.         {walk thru modeslist looking for VESA entry types ($100..$105)}
  561.       W := 0;
  562.       while (W < 100) and
  563. {$IFDEF Dpmi}
  564.             (VideoModePtr <> nil) and
  565. {$ENDIF}
  566.             (VideoModePtr^[W] <> $FFFF) do begin
  567.         if (VideoModePtr^[W] >= $100) and (VideoModePtr^[W] < $106) then
  568.           B[VideoModePtr^[W] - $100] := True;
  569.         Inc(W);
  570.       end;
  571.         {now walk thru boolean array setting table to match}
  572.       for W := 0 to 5 do
  573.         if NOT(B[w]) then
  574.           ModeList[w+1].Index := 0;
  575.     end;
  576.   end;
  577.  
  578.   procedure Cirrus; near; Assembler;
  579.   asm
  580.     mov     dx,3d4h
  581.     mov     al,0ch
  582.     out     dx,al
  583.     inc     dx
  584.     mov     ah,al
  585.     in      al,dx
  586.     xchg    ah,al
  587.     push    ax
  588.     push    dx
  589.     xor     al,al
  590.     out     dx,al
  591.  
  592.     mov     al,1fh
  593.     dec     dx
  594.     out     dx,al
  595.     inc     dx
  596.     in      al,dx
  597.     mov     bh,al
  598.  
  599.     mov     cl,4
  600.     mov     dx,3c4h
  601.     mov     bl,6
  602.  
  603.     ror     bh,cl
  604.     mov     ax,bx
  605.     out     dx,ax
  606.     inc     dx
  607.     in      al,dx
  608.     or      al,al
  609.     jnz     @@exit
  610.  
  611.     ror     bh,cl
  612.     dec     dx
  613.     mov     ax,bx
  614.     out     dx,ax
  615.     inc     dx
  616.     in      al,dx
  617.     cmp     al,1
  618.     jne     @@exit
  619.     mov     [svgatype],vtCirrus
  620.  
  621. @@exit:
  622.     pop     dx
  623.     dec     dx
  624.     pop     ax
  625.     out     dx,ax
  626.   end;
  627.  
  628.  
  629.   procedure NewBank; far; Assembler;
  630.   asm
  631.     push    cx
  632.     mov     cx,[svgatype]
  633.     cmp     cx,vtVESA
  634.     je      @@_vesa
  635.     cmp     cx,vtTseng4000
  636.     je      @@_tseng4
  637.     cmp     cx,vtTseng3000
  638.     je      @@_tseng
  639.     cmp     cx,vtTrident8800
  640.     je      @@_trident
  641.     cmp     cx,vtTrident8900
  642.     je      @@_trident
  643.     cmp     cx,vtS3Vga
  644.     je      @@_s3vga
  645.     cmp     cx,vtATIVGA
  646.     je      @@_ativga
  647.     cmp     cx,vtacumos
  648.     je      @@_acumos
  649.     cmp     cx,vtParadise
  650.     je      @@_paradise
  651.     cmp     cx,vtVideo7
  652.     je      @@_video7
  653.     cmp     cx,vtCompaq
  654.     je      @@_compaq
  655.     cmp     cx,vtGenoa
  656.     je      @@_genoa
  657.     cmp     cx,vtChipsTech
  658.     je      @@_chipstech
  659.     cmp     cx,vtAheadA
  660.     je      @@_aheada
  661.     cmp     cx,vtAheadB
  662.     je      @@_aheadb
  663.     cmp     cx,vtNCR
  664.     je      @@_ncr
  665.     cmp     cx,vtEverex
  666.     je      @@_everex
  667.     cmp     cx,vtOakTech
  668.     je      @@_oaktech
  669.     jmp     @@_nobank
  670.  
  671. @@_tseng:
  672.     push    ax
  673.     push    dx
  674.     cli
  675.     mov     [curbk],ax
  676.     and     al,7
  677.     mov     ah,al
  678.     shl     al,1
  679.     shl     al,1
  680.     shl     al,1
  681.     or      al,ah
  682.     or      al,01000000b
  683.     mov     dx,3cdh
  684.     out     dx,al
  685.     sti
  686.     pop     dx
  687.     pop     ax
  688.     jmp     @@alldone
  689.  
  690.  
  691. @@_tseng4:
  692.     push    ax
  693.     push    dx
  694.     cli
  695.     mov     [curbk],ax
  696.     mov     ah,al
  697.     mov     dx,3bfh
  698.     mov     al,3
  699.     out     dx,al
  700.     mov     dl,0d8h
  701.     mov     al,0a0h
  702.     out     dx,al
  703.     and     ah,15
  704.     mov     al,ah
  705.     shl     al,1
  706.     shl     al,1
  707.     shl     al,1
  708.     shl     al,1
  709.     or      al,ah
  710.     mov     dl,0cdh
  711.     out     dx,al
  712.     sti
  713.     pop     dx
  714.     pop     ax
  715.     jmp     @@alldone
  716.  
  717.  
  718. @@_trident:
  719.     push    ax
  720.     push    dx
  721.     push    ax
  722.     cli
  723.     mov     [curbk],ax
  724.     mov     dx,3ceh
  725.     mov     al,6
  726.     out     dx,al
  727.     inc     dl
  728.     in      al,dx
  729.     dec     dl
  730.     or      al,4
  731.     mov     ah,al
  732.     mov     al,6
  733.     out     dx,ax
  734.  
  735.     mov     dl,0c4h
  736.     mov     al,0bh
  737.     out     dx,al
  738.     inc     dl
  739.     in      al,dx
  740.     dec     dl
  741.  
  742.     pop     ax
  743.     mov     ah,al
  744.     xor     ah,2
  745.     mov     dx,3c4h
  746.     mov     al,0eh
  747.     out     dx,ax
  748.     sti
  749.     pop     dx
  750.     pop     ax
  751.     jmp     @@alldone
  752.  
  753.  
  754. @@_video7:
  755.     push    ax
  756.     push    dx
  757.     push    cx
  758.     cli
  759.     mov     [curbk],ax
  760.     and     ax,15
  761.     mov     ch,al
  762.     mov     dx,3c4h
  763.     mov     ax,0ea06h
  764.     out     dx,ax
  765.     mov     ah,ch
  766.     and     ah,1
  767.     mov     al,0f9h
  768.     out     dx,ax
  769.     mov     al,ch
  770.     and     al,1100b
  771.     mov     ah,al
  772.     shr     ah,1
  773.     shr     ah,1
  774.     or      ah,al
  775.     mov     al,0f6h
  776.     out     dx,al
  777.     inc     dx
  778.     in      al,dx
  779.     dec     dx
  780.     and     al,not 1111b
  781.     or      ah,al
  782.     mov     al,0f6h
  783.     out     dx,ax
  784.     mov     ah,ch
  785.     mov     cl,4
  786.     shl     ah,cl
  787.     and     ah,100000b
  788.     mov     dl,0cch
  789.     in      al,dx
  790.     mov     dl,0c2h
  791.     and     al,not 100000b
  792.     or      al,ah
  793.     out     dx,al
  794.     sti
  795.     pop     cx
  796.     pop     dx
  797.     pop     ax
  798.     jmp     @@alldone
  799.  
  800.  
  801. @@_paradise:
  802.     push    ax
  803.     push    dx
  804.     push    ax
  805.     cli
  806.     mov     [curbk],ax
  807.     mov     dx,3ceh
  808.     mov     ax,50fh
  809.     out     dx,ax
  810.     pop     ax
  811.     mov     ah,al
  812.     mov     al,9
  813.     out     dx,ax
  814.     sti
  815.     pop     dx
  816.     pop     ax
  817.     jmp     @@alldone
  818.  
  819. @@_acumos:
  820.     push    ax
  821.     push    dx
  822.     push    ax
  823.     cli
  824.     mov     [curbk],ax
  825.     mov     dx,3c4h
  826.     mov     ax,1206h
  827.     out     dx,ax
  828.     mov     dx,3ceh
  829.     pop     ax
  830.     mov     ah,al
  831.     mov     al,9
  832.     out     dx,ax
  833.     sti
  834.     pop     dx
  835.     pop     ax
  836.     jmp     @@alldone
  837.  
  838.  
  839. @@_chipstech:
  840.     push    ax
  841.     push    dx
  842.     push    ax
  843.     cli
  844.     mov     [curbk],ax
  845.     mov     dx,46e8h
  846.     mov     ax,1eh
  847.     out     dx,ax
  848.     mov     dx,103h
  849.     mov     ax,0080h
  850.     out     dx,ax
  851.     mov     dx,46e8h
  852.     mov     ax,0eh
  853.     out     dx,ax
  854.     pop     ax
  855.     mov     ah,al
  856.     mov     al,10h
  857.     mov     dx,3d6h
  858.     out     dx,ax
  859.     sti
  860.     pop     dx
  861.     pop     ax
  862.     jmp     @@alldone
  863.  
  864.  
  865. @@_ativga:
  866.     push    ax
  867.     push    dx
  868.     cli
  869.     mov     [curbk],ax
  870.     mov     ah,al
  871.     mov     dx,1ceh
  872.     mov     al,0b2h
  873.     out     dx,al
  874.     inc     dl
  875.     in      al,dx
  876.     shl     ah,1
  877.     and     al,0e1h
  878.     or      ah,al
  879.     mov     al,0b2h
  880.     dec     dl
  881.     out     dx,ax
  882.     sti
  883.     pop     dx
  884.     pop     ax
  885.     jmp     @@alldone
  886.  
  887.  
  888. @@_everex:
  889.     push    ax
  890.     push    dx
  891.     push    cx
  892.     cli
  893.     mov     [curbk],ax
  894.     mov     cl,al
  895.     mov     dx,3c4h
  896.     mov     al,8
  897.     out     dx,al
  898.     inc     dl
  899.     in      al,dx
  900.     dec     dl
  901.     shl     al,1
  902.     shr     cl,1
  903.     rcr     al,1
  904.     mov     ah,al
  905.     mov     al,8
  906.     out     dx,ax
  907.     mov     dl,0cch
  908.     in      al,dx
  909.     mov     dl,0c2h
  910.     and     al,0dfh
  911.     shr     cl,1
  912.     jc      @@nob2
  913.     or      al,20h
  914. @@nob2:
  915.     out     dx,al
  916.     sti
  917.     pop     cx
  918.     pop     dx
  919.     pop     ax
  920.     jmp     @@alldone
  921.  
  922.  
  923. @@_aheada:
  924.     push    ax
  925.     push    dx
  926.     push    cx
  927.     cli
  928.     mov     [curbk],ax
  929.     mov     ch,al
  930.     mov     dx,3ceh
  931.     mov     ax,200fh
  932.     out     dx,ax
  933.     mov     dl,0cch
  934.     in      al,dx
  935.     mov     dl,0c2h
  936.     and     al,11011111b
  937.     shr     ch,1
  938.     jnc     @@skpa
  939.     or      al,00100000b
  940. @@skpa:
  941.     out     dx,al
  942.     mov     dl,0cfh
  943.     mov     al,0
  944.     out     dx,al
  945.     inc     dx
  946.     in      al,dx
  947.     dec     dx
  948.     and     al,11111000b
  949.     or      al,ch
  950.     mov     ah,al
  951.     mov     al,0
  952.     out     dx,ax
  953.     sti
  954.     pop     cx
  955.     pop     dx
  956.     pop     ax
  957.     jmp     @@alldone
  958.  
  959.  
  960. @@_aheadb:
  961.     push    ax
  962.     push    dx
  963.     push    cx
  964.     cli
  965.     mov     [curbk],ax
  966.     mov     ch,al
  967.     mov     dx,3ceh
  968.     mov     ax,200fh
  969.     out     dx,ax
  970.     mov     ah,ch
  971.     mov     cl,4
  972.     shl     ah,cl
  973.     or      ah,ch
  974.     mov     al,0dh
  975.     out     dx,ax
  976.     sti
  977.     pop     cx
  978.     pop     dx
  979.     pop     ax
  980.     jmp     @@alldone
  981.  
  982.  
  983. @@_oaktech:
  984.     push    ax
  985.     push    dx
  986.     cli
  987.     mov     [curbk],ax
  988.     and     al,15
  989.     mov     ah,al
  990.     shl     al,1
  991.     shl     al,1
  992.     shl     al,1
  993.     shl     al,1
  994.     or      ah,al
  995.     mov     al,11h
  996.     mov     dx,3deh
  997.     out     dx,ax
  998.     sti
  999.     pop     dx
  1000.     pop     ax
  1001.     jmp     @@alldone
  1002.  
  1003. @@_genoa:
  1004.     push    ax
  1005.     push    dx
  1006.     cli
  1007.     mov     [curbk],ax
  1008.     mov     ah,al
  1009.     shl     al,1
  1010.     shl     al,1
  1011.     shl     al,1
  1012.     or      ah,al
  1013.     mov     al,6
  1014.     or      ah,40h
  1015.     mov     dx,3c4h
  1016.     out     dx,ax
  1017.     sti
  1018.     pop     dx
  1019.     pop     ax
  1020.     jmp     @@alldone
  1021.  
  1022. @@_ncr:
  1023.     push    ax
  1024.     push    dx
  1025.     cli
  1026.     mov     [curbk],ax
  1027.     mov     ah,al
  1028.     mov     al,18h
  1029.     mov     dx,3c4h
  1030.     out     dx,ax
  1031.     mov     ax,19h
  1032.     out     dx,ax
  1033.     sti
  1034.     pop     dx
  1035.     pop     ax
  1036.     jmp     @@alldone
  1037.  
  1038. @@_compaq:
  1039.     push    ax
  1040.     push    dx
  1041.     push    ax
  1042.     cli
  1043.     mov     [curbk],ax
  1044.     mov     dx,3ceh
  1045.     mov     ax,50fh
  1046.     out     dx,ax
  1047.     pop     ax
  1048.     mov     ah,al
  1049.     mov     al,45h
  1050.     out     dx,ax
  1051.     sti
  1052.     pop     dx
  1053.     pop     ax
  1054.     jmp     @@alldone
  1055.  
  1056. @@_s3vga:
  1057.     push    ax
  1058.     push    dx
  1059.     cli
  1060.     mov     [curbk],ax
  1061.     sti
  1062.     pop     dx
  1063.     pop     ax
  1064.     jmp     @@alldone
  1065.  
  1066. @@_vesa:
  1067.     push    ax
  1068.     cli
  1069.     mov     [curbk],ax
  1070.     mov     dx,ax
  1071.     xor     bx,bx
  1072.     mov     ax,4f05h
  1073.     push    bp
  1074.     int     10h
  1075.     pop     bp
  1076.     sti
  1077.     pop     ax
  1078.     jmp     @@alldone
  1079.  
  1080. @@_nobank:
  1081.     cli
  1082.     mov     [curbk],ax
  1083.     sti
  1084. @@alldone:
  1085.     pop     cx
  1086.   end;
  1087.  
  1088.   procedure GoChk; near; Assembler;
  1089.   asm
  1090.     push    si
  1091.     mov     si,bx
  1092.  
  1093.     mov     al,cl
  1094.     call    NewBank
  1095.     xchg    bl,es:[di]
  1096.     mov     al,ch
  1097.     call    NewBank
  1098.     xchg    bh,es:[di]
  1099.  
  1100.     xchg    si,bx
  1101.  
  1102.     mov     al,cl
  1103.     call    NewBank
  1104.     xor     bl,es:[di]
  1105.     mov     al,ch
  1106.     call    NewBank
  1107.     xor     bh,es:[di]
  1108.  
  1109.     xchg    si,bx
  1110.  
  1111.     mov     al,ch
  1112.     call    NewBank
  1113.     mov     es:[di],bh
  1114.     mov     al,cl
  1115.     call    NewBank
  1116.     mov     es:[di],bl
  1117.  
  1118.     mov     al,0
  1119.     call    NewBank
  1120.     or      si,si
  1121.     pop     si
  1122.   end;
  1123.  
  1124.   procedure ChkBk; near; Assembler;
  1125.   asm
  1126.     mov     di,[SegB800]
  1127.     mov     es,di
  1128.     xor     di,di
  1129.     mov     bx,1234h
  1130.     call    gochk
  1131.     jnz     @@badchk
  1132.     mov     bx,4321h
  1133.     call    gochk
  1134.     jnz     @@badchk
  1135.     clc
  1136.     jmp     @@goodchk
  1137. @@badchk:
  1138.     stc
  1139. @@goodchk:
  1140.   end;
  1141.  
  1142.   procedure IsPort2; near; Assembler;
  1143.   asm
  1144.     push    bx
  1145.     mov     bx,ax
  1146.     out     dx,al
  1147.     mov     ah,al
  1148.     inc     dx
  1149.     in      al,dx
  1150.     dec     dx
  1151.     xchg    al,ah
  1152.     push    ax
  1153.     mov     ax,bx
  1154.     out     dx,ax
  1155.     out     dx,al
  1156.     mov     ah,al
  1157.     inc     dx
  1158.     in      al,dx
  1159.     dec     dx
  1160.     and     al,bh
  1161.     cmp     al,bh
  1162.     jnz     @@noport
  1163.     mov     al,ah
  1164.     mov     ah,0
  1165.     out     dx,ax
  1166.     out     dx,al
  1167.     mov     ah,al
  1168.     inc     dx
  1169.     in      al,dx
  1170.     dec     dx
  1171.     and     al,bh
  1172.     cmp     al,0
  1173. @@noport:
  1174.     pop     ax
  1175.     out     dx,ax
  1176.     pop     bx
  1177.   end;
  1178.  
  1179.   procedure IsPort1; near; Assembler;
  1180.   asm
  1181.     mov     ah,al
  1182.     in      al,dx
  1183.     push    ax
  1184.     mov     al,ah
  1185.     out     dx,al
  1186.     in      al,dx
  1187.     and     al,ah
  1188.     cmp     al,ah
  1189.     jnz     @@noport
  1190.     mov     al,0
  1191.     out     dx,al
  1192.     in      al,dx
  1193.     and     al,ah
  1194.     cmp     al,0
  1195. @@noport:
  1196.     pop     ax
  1197.     out     dx,al
  1198.   end;
  1199.  
  1200.   procedure WhichVGA; Assembler;
  1201.   asm
  1202.     push    bp
  1203.     push    ax
  1204.     push    bx
  1205.     push    cx
  1206.     push    dx
  1207.     push    di
  1208.     push    si
  1209.     push    es
  1210.     cmp     [first],1
  1211.     jb      @@gotest
  1212.     mov     ax,[retval]
  1213.     mov     [svgatype],ax
  1214.     jmp     @@skipout
  1215.  
  1216. @@gotest:
  1217.     mov     [first],1
  1218.     mov     [vgamem],256
  1219.     mov     [bksize],64
  1220.     mov     [vesaavail],0
  1221.     xor     ax,ax
  1222.     mov     [svgatype],ax
  1223.  
  1224.     mov     ax,ds
  1225.     mov     es,ax
  1226.     lea     di,VESAVgaInfo
  1227.     mov     ax,4f00h
  1228.     push    bp
  1229.     int     10h
  1230.     pop     bp
  1231.     cmp     ax,4fh
  1232.     jnz     @@novesa
  1233.     mov     [svgatype],vtVESA
  1234.     mov     [vesaavail],1
  1235.     mov     [bksize],64
  1236.  
  1237. @@novesa:
  1238.     mov     ax,[VidBIOSSele]
  1239.     mov     es,ax
  1240.     cmp     word ptr es:[40h],'13'
  1241.     jnz     @@noati
  1242.     mov     [svgatype],vtATIVGA
  1243.     mov     [bksize],64
  1244.     mov     dx,es:[10h]
  1245.     mov     bl,es:[43h]
  1246.     cmp     bl,'3'
  1247.     jae     @@v6up
  1248.     mov     al,0bbh
  1249.     cli
  1250.     out     dx,al
  1251.     inc     dx
  1252.     in      al,dx
  1253.     sti
  1254.     test    al,20h
  1255.     jz      @@no512
  1256.     mov     [vgamem],512
  1257.     jmp     @@no512
  1258.  
  1259. @@v6up:
  1260.     mov     al,0b0h
  1261.     cli
  1262.     out     dx,al
  1263.     inc     dx
  1264.     in      al,dx
  1265.     sti
  1266.     test    al,10h
  1267.     jz      @@v7up
  1268.     mov     [vgamem],512
  1269. @@v7up:
  1270.     cmp     bl,'4'
  1271.     jb      @@no512
  1272.     test    al,8
  1273.     jz      @@no512
  1274.     mov     [vgamem],1024
  1275. @@no512:
  1276.     jmp     @@fini
  1277.  
  1278. @@noati:
  1279.     mov     ax,7000h
  1280.     xor     bx,bx
  1281.     cld
  1282.     push    bp
  1283.     int     10h
  1284.     pop     bp
  1285.     cmp     al,70h
  1286.     jnz     @@noev
  1287.     mov     [svgatype],vtEverex
  1288.     mov     [bksize],64
  1289.     and     ch,11000000b
  1290.     jz      @@skp
  1291.     mov     [vgamem],512
  1292. @@skp:
  1293.  
  1294. @@noev:
  1295.     mov     ax,0bf03h
  1296.     xor     bx,bx
  1297.     mov     cx,bx
  1298.     push    bp
  1299.     int     10h
  1300.     pop     bp
  1301.     cmp     ax,0bf03h
  1302.     jnz     @@nocp
  1303.     test    cl,40h
  1304.     jz      @@nocp
  1305.     mov     [svgatype],vtCompaq
  1306.     mov     [bksize],4
  1307.     mov     [vgamem],512
  1308.     jmp     @@fini
  1309.  
  1310. @@nocp:
  1311.     mov     dx,3c4h
  1312.     mov     ax,0ff05h
  1313.     call    isport2
  1314.     jnz     @@noncr
  1315.     mov     ax,5
  1316.     out     dx,ax
  1317.     mov     ax,0ff10h
  1318.     call    isport2
  1319.     jz      @@noncr
  1320.     mov     ax,105h
  1321.     out     dx,ax
  1322.     mov     ax,0ff10h
  1323.     call    isport2
  1324.     jnz     @@noncr
  1325.     mov     [svgatype],vtNCR
  1326.     mov     [bksize],16
  1327.     mov     [vgamem],512
  1328.     jmp     @@fini
  1329.  
  1330. @@noncr:
  1331.     mov     dx,3c4h
  1332.     mov     al,0bh
  1333.     out     dx,al
  1334.     inc     dl
  1335.     in      al,dx
  1336.     and     al,0fh
  1337.     cmp     al,06h
  1338.     ja      @@notri
  1339.     cmp     al,2
  1340.     jb      @@notri
  1341.     mov     [svgatype],vtTrident8800
  1342.     mov     [bksize],64
  1343.     cmp     al,3
  1344.     jb      @@no89
  1345.     mov     [svgatype],vtTrident8900
  1346.     mov     dx,3d5h
  1347.     mov     al,1fh
  1348.     out     dx,al
  1349.     inc     dx
  1350.     in      al,dx
  1351.     and     al,3
  1352.     cmp     al,1
  1353.     jb      @@notmem
  1354.     mov     [vgamem],512
  1355.     je      @@notmem
  1356.     mov     [vgamem],1024
  1357. @@notmem:
  1358.     jmp     @@fini
  1359.  
  1360. @@no89:
  1361.     mov     [vgamem],512
  1362.     jmp     @@fini
  1363.  
  1364. @@notri:
  1365.     mov     ax,6f00h
  1366.     xor     bx,bx
  1367.     cld
  1368.     push    bp
  1369.     int     10h
  1370.     pop     bp
  1371.     cmp     bx,'V7'
  1372.     jnz     @@nov7
  1373.     mov     [svgatype],vtVideo7
  1374.     mov     [bksize],64
  1375.     mov     ax,6f07h
  1376.     cld
  1377.     push    bp
  1378.     int     10h
  1379.     pop     bp
  1380.     and     ah,7fh
  1381.     cmp     ah,1
  1382.     jbe     @@skp2
  1383.     mov     [vgamem],512
  1384. @@skp2:
  1385.     cmp     ah,3
  1386.     jbe     @@skp3
  1387.     mov     [vgamem],1024
  1388. @@skp3:
  1389.     jmp     @@fini
  1390.  
  1391. @@nov7:
  1392.     mov     dx,3d4h
  1393.     mov     ax,032eh
  1394.     call    isport2
  1395.     jnz     @@nogn
  1396.     mov     dx,3c4h
  1397.     mov     ax,3f06h
  1398.     call    isport2
  1399.     jnz     @@nogn
  1400.     mov     [svgatype],vtGenoa
  1401.     mov     [bksize],64
  1402.     mov     [vgamem],512
  1403.     jmp     @@fini
  1404.  
  1405. @@nogn:
  1406.     call    cirrus
  1407.     cmp     [svgatype],vtCirrus
  1408.     jne     @@noci
  1409.     jmp     @@fini
  1410.  
  1411. @@noci:
  1412.     mov     dx,3ceh
  1413.     mov     al,9
  1414.     out     dx,al
  1415.     inc     dx
  1416.     in      al,dx
  1417.     dec     dx
  1418.     or      al,al
  1419.     jnz     @@nopd
  1420.  
  1421.     mov     ax,50fh
  1422.     out     dx,ax
  1423.     mov     [svgatype],vtParadise
  1424.     mov     cx,1
  1425.     call    chkbk
  1426.     mov     [svgatype],0
  1427.     jc      @@nopd
  1428.     mov     [svgatype],vtParadise
  1429.     mov     [bksize],4
  1430.     mov     dx,3ceh
  1431.     mov     al,0bh
  1432.     out     dx,al
  1433.     inc     dx
  1434.     in      al,dx
  1435.     test    al,80h
  1436.     jz      @@nop512
  1437.     mov     [vgamem],512
  1438. @@nop512:
  1439.     jmp     @@fini
  1440.  
  1441. @@nopd:
  1442.     mov     ax,5f00h
  1443.     xor     bx,bx
  1444.     cld
  1445.     push    bp
  1446.     int     10h
  1447.     pop     bp
  1448.     cmp     al,5fh
  1449.     jnz     @@noct
  1450.     mov     [svgatype],vtChipsTech
  1451.     mov     [bksize],16
  1452.     cmp     bh,1
  1453.     jb      @@skp4
  1454.     mov     [vgamem],512
  1455. @@skp4:
  1456.     jmp     @@fini
  1457.  
  1458. @@noct:
  1459.     mov     ch,0
  1460.     mov     dx,3d4h
  1461.     mov     ax,0f33h
  1462.     call    isport2
  1463.     jnz     @@not4
  1464.     mov     ch,1
  1465.  
  1466.     mov     dx,3bfh
  1467.     mov     al,3
  1468.     out     dx,al
  1469.     mov     dx,3d8h
  1470.     mov     al,0a0h
  1471.     out     dx,al
  1472.     jmp     @@yes4
  1473.  
  1474. @@not4:
  1475.     mov     dx,3d4h
  1476.     mov     ax,1f25h
  1477.     call    isport2
  1478.     jnz     @@nots
  1479.     mov     al,03fh
  1480.     jmp     @@yes3
  1481. @@yes4:
  1482.     mov     al,0ffh
  1483. @@yes3:
  1484.     mov     dx,3cdh
  1485.     call    isport1
  1486.     jnz     @@nots
  1487.     mov     [svgatype],vtTseng3000
  1488.     mov     [bksize],64
  1489.     cmp     ch,0
  1490.     jnz     @@t4mem
  1491.     mov     [vgamem],512
  1492.     jmp     @@fini
  1493.  
  1494. @@t4mem:
  1495.     mov     dx,3d4h
  1496.     mov     al,37h
  1497.     out     dx,al
  1498.     inc     dx
  1499.     in      al,dx
  1500.     test    al,1000b
  1501.     jz      @@nomem
  1502.     and     al,3
  1503.     cmp     al,1
  1504.     jbe     @@nomem
  1505.     mov     [vgamem],512
  1506.     cmp     al,2
  1507.     je      @@nomem
  1508.     mov     [vgamem],1024
  1509. @@nomem:
  1510.     mov     [svgatype],vtTseng4000
  1511.     mov     [bksize],64
  1512.     jmp     @@fini
  1513.  
  1514. @@nots:
  1515.     mov     dx,3ceh
  1516.     mov     ax,200fh
  1517.     out     dx,ax
  1518.     inc     dx
  1519.     in      al,dx
  1520.     cmp     al,21h
  1521.     jz      @@verb
  1522.     cmp     al,20h
  1523.     jnz     @@noab
  1524.     mov     [svgatype],vtAheadA
  1525.     mov     [bksize],64
  1526.     mov     [vgamem],512
  1527.     jmp     @@fini
  1528.  
  1529. @@verb:
  1530.     mov     [svgatype],vtAheadB
  1531.     mov     [bksize],64
  1532.     mov     [vgamem],512
  1533.     jmp     @@fini
  1534.  
  1535. @@noab:
  1536.     mov     dx,3c4h
  1537.     mov     ax,0006h
  1538.     out     dx,ax
  1539.     mov     ax,0ff09h
  1540.     call    isport2
  1541.     jz      @@noacu
  1542.     mov     ax,0ff0ah
  1543.     call    isport2
  1544.     jz      @@noacu
  1545.     mov     ax,1206h
  1546.     out     dx,ax
  1547.     mov     ax,0ff09h
  1548.     call    isport2
  1549.     jnz     @@noacu
  1550.     mov     ax,0ff0ah
  1551.     call    isport2
  1552.     jnz     @@noacu
  1553.     mov     [svgatype],vtAcuMOS
  1554.     mov     cx,1
  1555.     call    chkbk
  1556.     mov     [svgatype],0
  1557.     jc      @@noacu
  1558.     mov     [svgatype],vtAcuMOS
  1559.     mov     [bksize],4
  1560.     mov     dx,3c4h
  1561.     mov     al,0ah
  1562.     out     dx,al
  1563.     inc     dx
  1564.     in      al,dx
  1565.     and     al,3
  1566.     cmp     al,1
  1567.     jb      @@noamem
  1568.     mov     [vgamem],512
  1569.     cmp     al,2
  1570.     jb      @@noamem
  1571.     mov     [vgamem],1024
  1572.     cmp     al,3
  1573.     jb      @@noamem
  1574.     mov     [vgamem],2048
  1575. @@noamem:
  1576.     jmp     @@fini
  1577.  
  1578. @@noacu:
  1579.     mov     dx,3deh
  1580.     mov     ax,0ff11h
  1581.     call    isport2
  1582.     jnz     @@nooak
  1583.     mov     [svgatype],vtOakTech
  1584.     mov     [bksize],64
  1585.     mov     al,0dh
  1586.     out     dx,al
  1587.     inc     dx
  1588.     in      al,dx
  1589.     test    al,11000000b
  1590.     jz      @@no4ram
  1591.     mov     [vgamem],512
  1592.     test    al,01000000b
  1593.     jz      @@no4ram
  1594.     mov     [vgamem],1024
  1595. @@no4ram:
  1596.     jmp     @@fini
  1597.  
  1598. @@nooak:
  1599.     jmp     @@nos3
  1600.     mov     [svgatype],vtS3Vga
  1601.     mov     [bksize],64
  1602.     mov     [vgamem],1024
  1603.     jmp     @@fini
  1604.  
  1605. @@nos3:
  1606.     cmp     [vesaavail],0
  1607.     je      @@nosvga
  1608.     mov     [vgamem],2048
  1609.     jmp     @@fini
  1610.  
  1611. @@nosvga:
  1612.     mov     [svgatype],0
  1613.  
  1614. @@fini:
  1615.     cmp     [vesaavail],1
  1616.     jne     @@sorry
  1617.     mov     [svgatype],vtVESA
  1618. @@sorry:
  1619.     mov     ax,[svgatype]
  1620.     mov     [retval],ax
  1621. @@skipout:
  1622.     pop     es
  1623.     pop     si
  1624.     pop     di
  1625.     pop     dx
  1626.     pop     cx
  1627.     pop     bx
  1628.     pop     ax
  1629.     pop     bp
  1630.   end;
  1631.  
  1632.   procedure DetectSVGAType(CheckHW : Boolean);
  1633.   var
  1634.     Reg : Registers;
  1635.     Tmp : Integer;
  1636.   begin
  1637.     if CurrentDisplay <> VGA then exit;
  1638.  
  1639.     if (CheckHW) or (not(VidChecked)) then begin
  1640.       VidChecked := True;
  1641.       WhichVGA;
  1642.       BankSize := Word((LongInt(BkSize) * 1024)-1);
  1643.     end;
  1644.   end;
  1645.  
  1646. {$ENDIF}
  1647.  
  1648. {-------------------------}
  1649. { Video hardware routines }
  1650. {-------------------------}
  1651.  
  1652.   procedure PlotBIOSPixel(X,Y : Word; C : Byte);
  1653.     {-plot a single pixel using BIOS services}
  1654.   var
  1655.     R : Registers;
  1656.   begin
  1657.     asm
  1658.       mov    ah,0Ch
  1659.       mov    al,C
  1660.       mov    cx,X
  1661.       mov    dx,Y
  1662.       push   bp
  1663.       int    10h
  1664.       pop    bp
  1665.     end;
  1666.   end;
  1667.  
  1668.   procedure PlotBIOSLine(Y : Word);
  1669.     {-plot a raster line using BIOS services}
  1670.   var
  1671.     X : Integer;
  1672.   begin
  1673.     asm
  1674.       xor    bx,bx
  1675.       mov    si,offset RasterLine
  1676.       mov    dx,Y
  1677.       mov    ah,0Ch
  1678.       xor    al,al
  1679.       mov    cx,RightEdge
  1680.       sub    cx,LeftEdge
  1681.       cld
  1682. @@Top:
  1683.       jcxz   @@Done
  1684.       mov    al,[si+bx]
  1685.       push   ax
  1686.       push   bx
  1687.       push   cx
  1688.       mov    cx,bx
  1689.       add    cx,LeftEdge
  1690.       xor    bx,bx
  1691.       push   bp
  1692.       int    10h
  1693.       pop    bp
  1694.       pop    cx
  1695.       pop    bx
  1696.       pop    ax
  1697.       inc    bx
  1698.       loop   @@Top
  1699. @@Done:
  1700.     end;
  1701.   end;
  1702.  
  1703.   procedure PlotCGALoLine(Y : Word);
  1704.     {-plot a raster line in CGA 320x200x4 mode}
  1705.   var
  1706.     X,M,VOfs : Word;
  1707.     Tmp : Array[0..79] of Byte;
  1708.   begin
  1709.       {calc offset in vmem of scanline to plot}
  1710.     VOfs := ((Y and 1) shl 13) + (80 * (Y shr 1)) + ((LeftEdge shr 2) mod 80);
  1711.     M := 0;
  1712.     FillChar(Tmp,80,0);
  1713.     X := LeftEdge;
  1714.       {load our holding buffer with the line.  CGA low uses 2 bits/pixel}
  1715.     repeat
  1716.       Tmp[m] := Tmp[m] or (((RasterLine[X] and $03) shl 6) shr ((X mod 4) shl 1));
  1717.       Inc(X);
  1718.       if (X and 3) = 0 then Inc(M);
  1719.     until X > RightEdge;
  1720.       {move the line to vmem}
  1721.     Move(Tmp,Ptr(ColorSele,VOfs)^,M);
  1722.   end;
  1723.  
  1724.   procedure PlotCGAHiLine(Y : Word);
  1725.     {-plot a raster line in CGA 640x200x2 mode}
  1726.   var
  1727.     X,M,VOfs : Word;
  1728.     Tmp : Array[0..79] of Byte;
  1729.   begin
  1730.       {same as CGALo, but uses 1 bit/pixel}
  1731.     VOfs := ((Y and 1) shl 13) + (80 * (Y shr 1)) + ((LeftEdge shr 3) mod 80);
  1732.     M := 0;
  1733.     FillChar(Tmp,80,0);
  1734.     X := LeftEdge;
  1735.     repeat
  1736.       Tmp[m] := Tmp[m] or (((RasterLine[X] and 1) shl 7) shr (X mod 8));
  1737.       Inc(X);
  1738.       if (X and 7) = 0 then Inc(M);
  1739.     until X > RightEdge;
  1740.     Move(Tmp,Ptr(ColorSele,VOfs)^,M);
  1741.   end;
  1742.  
  1743.   procedure PlotEGALine(Y : Word);
  1744.     {-plot EGA raster line in modes $0D - $12}
  1745.   var
  1746.     I : Word;
  1747.   begin
  1748.     asm
  1749.       mov    ax,Y
  1750.       mul    EGABytesPerLine
  1751.       mov    bx,LeftEdge
  1752.       shr    bx,1
  1753.       shr    bx,1
  1754.       shr    bx,1
  1755.       add    ax,bx
  1756.       mov    di,ax
  1757.       mov    es,VGASele
  1758.       mov    si,offset RasterLine
  1759.       mov    ah,80h
  1760.       mov    cx,LeftEdge
  1761.       ror    ah,cl
  1762.       mov    dx,3CEh
  1763.       mov    cx,RightEdge
  1764.       sub    cx,LeftEdge
  1765.       inc    cx
  1766.       mov    al,08h
  1767.       cld
  1768. @@Top:
  1769.       jcxz   @@Done
  1770.       out    dx,ax
  1771.       mov    bl,[si]
  1772.       mov    bh,es:[di]
  1773.       mov    es:[di],bl
  1774.       inc    si
  1775.       ror    ah,1
  1776.       cmp    ah,80h
  1777.       jne    @@Check
  1778.       inc    di
  1779. @@Check:
  1780.       loop   @@Top
  1781. @@Done:
  1782.     end;
  1783.   end;
  1784.  
  1785.   procedure PlotEGALineDbl(Y : Word);
  1786.     {-plot special EGA raster line in mode $12 for expanded weather maps}
  1787.   begin
  1788.     Move(RasterLine[0], RasterLine[1280], 378);
  1789.     asm
  1790.       mov    si,offset RasterLine
  1791.       mov    di,si
  1792.       add    si,1280
  1793.       mov    ax,ds
  1794.       mov    es,ax
  1795.       mov    cx,378
  1796.       xor    bx,bx
  1797.       cld
  1798. @@Top:
  1799.       jcxz   @@Done
  1800.       movsb
  1801.       dec    si
  1802.       movsb
  1803.       inc    bx
  1804.       cmp    bx,5
  1805.       jne    @@Skip
  1806.       xor    bx,bx
  1807.       dec    cx
  1808.       inc    si
  1809. @@Skip:
  1810.       loop   @@Top
  1811. @@Done:
  1812.     end;
  1813.     PlotEGALine(Y);
  1814.     PlotEGALine(Y+1);
  1815.   end;
  1816.  
  1817.   procedure PlotVGALine(Y : Word);
  1818.     {-plot a raster line in VGA mode $13}
  1819.   begin
  1820.     asm
  1821.       mov    ax,Y
  1822.       mul    Pixels
  1823.       add    ax,LeftEdge
  1824.       mov    di,ax
  1825.       mov    es,VGASele
  1826.       mov    si,offset RasterLine
  1827.       mov    cx,RightEdge
  1828.       sub    cx,LeftEdge
  1829.       cld
  1830.       rep    movsb
  1831.     end;
  1832.   end;
  1833.  
  1834. {$IFDEF UseSVGA}
  1835.   procedure PlotSVGALine(Y : Word);
  1836.     {-plot a raster line in SVGA modes}
  1837.   begin
  1838.     asm
  1839.       mov    ax,Y
  1840.       cwd
  1841.       mul    Pixels
  1842.       add    ax,LeftEdge
  1843.       adc    dx,0
  1844.       push   ax
  1845.       cmp    dx,CurBk
  1846.       jne    @@Switch1
  1847.       mov    cx,RightEdge
  1848.       sub    cx,LeftEdge
  1849.       add    ax,cx
  1850.       adc    dx,0
  1851.       cmp    dx,CurBk
  1852.       jne    @@Switch2
  1853.  
  1854. @@NoSwitch:
  1855.       mov    si,offset RasterLine
  1856.       mov    es,VGASele
  1857.       pop    di
  1858.       cld
  1859.       rep    movsb
  1860.       jmp    @@Done
  1861.  
  1862. @@Switch1:
  1863.       mov    CurBk,dx
  1864.       xor    dx,dx
  1865.       mov    ax,CurBk
  1866.       call   NewBank
  1867.       jmp    @@Skip
  1868. @@Switch2:
  1869.       mov    CurBk,dx
  1870.       xor    dx,dx
  1871. @@Skip:
  1872.       mov    cx,RightEdge
  1873.       sub    cx,LeftEdge
  1874.       pop    di
  1875.       mov    si,offset RasterLine
  1876.       mov    es,VGASele
  1877.       cld
  1878. @@Top:
  1879.       jcxz   @@Done
  1880.       movsb
  1881.       cmp    di,0
  1882.       ja     @@SkipSwitch
  1883.       mov    ax,CurBk
  1884.       call   NewBank
  1885. @@SkipSwitch:
  1886.       loop   @@Top
  1887. @@Done:
  1888.     end;
  1889.   end;
  1890. {$ENDIF}
  1891.  
  1892. {---------------------------------------------------------------------------}
  1893.  
  1894.   procedure AdjustPalette(Mode : Byte);
  1895.     {-set hardware palette to match image map}
  1896.   var R : Registers;
  1897.   begin
  1898.     FillChar(RasterLine,SizeOf(TRasterLine),0);         {blank line to start}
  1899.     with R do begin
  1900.       if Mode >= $13 then begin
  1901.         ah := $10;
  1902.         al := $12;
  1903.         bx := 0;
  1904.         cx := Maps[Curmap].HighColorNum+1; {# of palette entries in use}
  1905.         es := Seg(VGAPalette);
  1906.         dx := Ofs(VGAPalette);
  1907.         Intr($10, R);
  1908.       end
  1909.       else if Mode >= $0D then begin
  1910.         ah := $10;
  1911.         al := $02;
  1912.         bx := 0;
  1913.         es := Seg(EGAPalette);
  1914.         dx := Ofs(EGAPalette);
  1915.         Intr($10, R);
  1916.       end;
  1917.     end;
  1918.   end;
  1919.  
  1920.   procedure SetMode(Mode : Byte);
  1921.     {-low level video mode set via BIOS}
  1922.   var R : Registers;
  1923.   begin
  1924.     R.ah := $00;
  1925.     R.al := Mode;
  1926.     Intr($10,R);
  1927.   end;
  1928.  
  1929. {$IFDEF UseSVGA}
  1930.   procedure SetSVGAMode(Mode : Byte);
  1931.     {-special BIOS setmode for SVGA chipsets, using ModeList.  Some SVGA}
  1932.     {chipsets use a constant AX value for SVGA modes with a second value}
  1933.     {in BL to select the actual mode; we handle that here.              }
  1934.   var
  1935.     B : Integer;
  1936.     R : Registers;
  1937.   begin
  1938.     B := Mode - $F0;
  1939.     MaxColors := ModeList[B].MaxC;
  1940.     if SVGAType = vtVESA then begin
  1941.       R.ax := $4F02;
  1942.       R.bx := ModeList[B].ModeAX;
  1943.     end
  1944.     else begin
  1945.       R.ax := ModeList[B].ModeAX;
  1946.       R.bl := ModeList[B].ModeBL;
  1947.     end;
  1948.     Intr($10,R);
  1949.     if SVGAType = vtVESA then begin
  1950.       R.ax := $4F01;
  1951.       R.cx := ModeList[B].ModeAX;
  1952.       R.es := Seg(VesaModeInfo);
  1953.       R.di := Ofs(VesaModeInfo);
  1954.       Intr($10,R);
  1955.     end;
  1956.   end;
  1957.  
  1958.   procedure SelectModeTable;
  1959.     {-select which modetable to use based on chipset type}
  1960.   begin
  1961.     FillChar(ModeList,SizeOf(ModeList),0);
  1962.     case SVGAType of
  1963.       vtTseng3000:
  1964.         ModeList := Tseng3000Table;
  1965.       vtTseng4000:
  1966.         ModeList := Tseng4000Table;
  1967.       vtTrident8800:
  1968.         ModeList := TridentTable;
  1969.       vtTrident8900:
  1970.         ModeList := Trident8900Table;
  1971.       vtParadise:
  1972.         ModeList := ParadiseTable;
  1973.       vtVideo7:
  1974.         ModeList := Video7Table;
  1975.       vtATIVGA:
  1976.         ModeList := ATITable;
  1977.       vtChipsTech:
  1978.         ModeList := ChipsTechTable;
  1979.       vtAheadA, vtAheadB:
  1980.         ModeList := AheadTable;
  1981.       vtEverex:
  1982.         ModeList := EverexTable;
  1983.       vtAcuMOS:
  1984.         ModeList := AcuMOSTable;
  1985.       vtNCR:
  1986.         ModeList := NCRTable;
  1987.       vtGenoa:
  1988.         ModeList := GenoaTable;
  1989.       vtOakTech:
  1990.         ModeList := OakTable;
  1991.       vtVESA:
  1992.         ModeList := VESATable;
  1993.     end;
  1994.   end;
  1995. {$ENDIF}
  1996.  
  1997.   procedure SetGraphicsMode(Mode : Byte);
  1998.     {-sets selected grahics mode}
  1999.   begin
  2000.     OldMode := LastMode;
  2001.     OldFont8x8 := Font8x8Selected;
  2002. {$IFDEF UseSVGA}
  2003.     if (Mode > $13) and (SVGAType > 0) then
  2004.       SetSVGAMode(Mode)
  2005.     else
  2006. {$ENDIF}
  2007.     if Mode = $09 then begin
  2008.       if WhichHerc = HercInColor then
  2009.         SwitchInColorCard(False);
  2010.       SetHercMode(True,0);
  2011.         {clear the screen}
  2012.       FillChar(Ptr(SegB000, 0)^,$7FFF,0);
  2013.     end
  2014.     else
  2015.       SetMode(Mode);           {low-level video mode set}
  2016.     if (Mode >= $0D) and (Mode <= $12) then begin
  2017.         {EGA, set up EGA CRTC as we need it}
  2018.       PortW[$03CE] := $1803;
  2019.       PortW[$03CE] := $0205;
  2020.     end;
  2021.     GraphOn := True;
  2022.   end;
  2023.  
  2024.   procedure SetTextMode;
  2025.     {-restore text mode}
  2026.   begin
  2027.     if SelMode = $09 then begin
  2028.       SetHercMode(False,0);
  2029.       if WhichHerc = HercInColor then
  2030.         SwitchInColorCard(True);
  2031.     end
  2032.     else
  2033.       SetMode(OldMode);
  2034.     TextMode(OldMode);
  2035.     SelectFont8x8(OldFont8x8);
  2036.     ReinitCrt;
  2037.     ClrScr;
  2038.     GraphOn := False;
  2039.   end;
  2040.  
  2041.   procedure FillBackground;
  2042.   var
  2043.     W : Word;
  2044.   begin
  2045.     LeftEdge := 0;
  2046.     RightEdge := ScrWidth;
  2047.     FillChar(RasterLine, SizeOf(RasterLine), Maps[Global].BackgrColorIndex);
  2048.     for W := 0 to Pred(ScrHeight) do
  2049.       PlotLine(W);
  2050.     FillChar(RasterLine, SizeOf(RasterLine), 0);
  2051.   end;
  2052.  
  2053.   function SelectMode(X,Y : Word) : Byte;
  2054.     {-uses image X/Y resolution to select video mode}
  2055.   var
  2056.     B : Byte;
  2057.   begin
  2058.     DetectSVGAType(True);
  2059.  
  2060.     EGABytesPerLine := 80;
  2061.     MaxColors := 16;
  2062.     Pixels := 640;
  2063.     PlotLine := PlotEGALine;
  2064.  
  2065.     if (CurrentDisplay in [EGA,VGA]) and
  2066.        (X = 378) and
  2067.        (Y = 240) then begin
  2068.         {CIS Weather map in odd size, do special handling}
  2069.       if (DoDbl) then begin
  2070.         Pixels := 378*2;
  2071.         Raster := 480;
  2072.         MaxColors := 16;
  2073.         SelectMode := $12;
  2074.         PlotLine := PlotEGALineDbl;
  2075.       end
  2076.       else begin
  2077.         Pixels := 640;
  2078.         Raster := 480;
  2079.         MaxColors := 16;
  2080.         SelectMode := $12;
  2081.         PlotLine := PlotEGALine;
  2082.       end;
  2083.       exit;
  2084.     end;
  2085.  
  2086. {$IFDEF UseSVGA}
  2087.       {if we're an SVGA, select a matching mode}
  2088.     if (CurrentDisplay = VGA) and (SVGAType > 0) then begin
  2089.         {set our mode table and vars}
  2090.       SelectModeTable;
  2091.       PlotLine := PlotSVGALine;
  2092.       MaxColors := 256;
  2093.       CurBk := 0;
  2094.  
  2095.         {Match a mode index to Y res.  The vast majority of SVGA GIFs are}
  2096.         {"tall/narrow" rather than "short/wide", so this is a safe match,}
  2097.         {but we allow for 640x200 CGA-type images as well.}
  2098.       case Y of
  2099.         601..MaxInt:
  2100.           B := $F6;
  2101.         481..600:
  2102.           B := $F4;
  2103.         401..480:
  2104.           B := $F2;
  2105.         201..400:
  2106.           B := $F1;
  2107.         else
  2108.           begin
  2109.             if X > 320 then
  2110.               B := $F1
  2111.             else begin
  2112.               SelectMode := $13;
  2113.               Raster := 200;
  2114.               Pixels := 320;
  2115.               PlotLine := PlotVGALine;
  2116.               exit;
  2117.             end;
  2118.           end;
  2119.       end;
  2120.  
  2121.         {walk up mode table til we get a supported mode}
  2122.       while (B > $F1) and (ModeList[B-$F0].Index = 0) do
  2123.         Dec(B);
  2124.  
  2125.         {now match colors and resolution}
  2126.       SelectMode := B;
  2127.       MaxColors := ModeList[B-$F0].MaxC;
  2128.       case B of
  2129.         $F5,$F6:
  2130.           begin
  2131.             Raster := 768;
  2132.             Pixels := 1024;
  2133.           end;
  2134.         $F3,$F4:
  2135.           begin
  2136.             Raster := 600;
  2137.             Pixels := 800;
  2138.           end;
  2139.         $F2:
  2140.           begin
  2141.             Raster := 480;
  2142.             Pixels := 640;
  2143.           end;
  2144.         $F1:
  2145.           begin
  2146.             Raster := 400;
  2147.             Pixels := 640;
  2148.           end;
  2149.       end;
  2150.  
  2151.         {16 color modes > 640x480 are wierd, use the BIOS to plot}
  2152.       if (MaxColors = 16) and (Raster > 480) then
  2153.         PlotLine := PlotBIOSLine;
  2154.     end
  2155.  
  2156.     else
  2157. {$ENDIF}
  2158.     if (CurrentDisplay = EGA) or (CurrentDisplay = VGA) then begin
  2159.         {if > 350 lines, use EGA/VGA mode $12 (640x480x16)}
  2160.       EGABytesPerLine := 80;
  2161.       MaxColors := 16;
  2162.       Pixels := 640;
  2163.       PlotLine := PlotEGALine;
  2164.  
  2165.       if (Y > 350) and ((CurrentDisplay = VGA) or (AllowEGAMode12)) then begin
  2166.         Raster := 480;
  2167.         SelectMode := $12;
  2168.       end
  2169.  
  2170.         {if we fit CGAHi specs, use it}
  2171.       else if (Y <= 200) and (X <= 640) and
  2172.               (Maps[CurMap].HighColorNum < 2) then begin
  2173.         Raster := 200;
  2174.         Pixels := 640;
  2175.         PlotLine := PlotCGAHiLine;
  2176.         SelectMode := $06;
  2177.       end
  2178.  
  2179.       else if (Y <= 200) and (X <= 320) then begin
  2180.           {if we meet std. VGA specs, use VGA mode $13 (320x200x256)}
  2181.         if (CurrentDisplay = VGA) then begin
  2182.           MaxColors := 256;
  2183.           Raster := 200;
  2184.           Pixels := 320;
  2185.           PlotLine := PlotVGALine;
  2186.           SelectMode := $13;
  2187.         end
  2188.           {otherwise use EGA native mode $0D (320x200x16)}
  2189.         else begin
  2190.           Raster := 200;
  2191.           Pixels := 320;
  2192.           EGABytesPerLine := 40;
  2193.           SelectMode := $0D;
  2194.         end;
  2195.       end
  2196.  
  2197.         {default to "standard" EGA/VGA mode $10 (640x350x16)}
  2198.       else begin
  2199.         Raster := 350;
  2200.         SelectMode := $10;
  2201.       end;
  2202.     end
  2203.  
  2204.     else if CurrentDisplay = CGA then begin
  2205.         {if > 320 pixels, use CGA mode $06}
  2206.       Raster := 200;
  2207.       if X > 320 then begin
  2208.         PlotLine := PlotCGAHiLine;
  2209.         Pixels := 640;
  2210.         SelectMode := $06;
  2211.       end
  2212.       else begin
  2213.           {use CGA mode $05, which turns off color burst to "grayscale" image}
  2214.           {since the standard CGA palettes match almost nothing <g>}
  2215.         PlotLine := PlotCGALoLine;
  2216.         Pixels := 320;
  2217.         SelectMode := $05;
  2218.       end;
  2219.     end
  2220.  
  2221.     else begin
  2222.       WriteLn('** Unsupported video system detected **');
  2223.       SelectMode := 0;
  2224.     end;
  2225.   end;
  2226.  
  2227. {$IFDEF Dpmi}
  2228. begin
  2229.   GetSelectorForRealMem(Ptr($A000,0), $FFFF, VGASele);
  2230.   GetSelectorForRealMem(Ptr($C000,0), $FFFF, VidBIOSSele);
  2231. {$ENDIF}
  2232. end.
  2233.  
  2234.